home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyBarcodes.p < prev    next >
Encoding:
Text File  |  1996-06-01  |  1.8 KB  |  83 lines  |  [TEXT/CWIE]
  1. unit MyBarcodes;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.         
  8.     const
  9.         narrowLineWidth = 1;
  10.         wideLineWidth = 3 * narrowLineWidth;
  11.         barCodeWidth = (3 * wideLineWidth) + (7 * narrowLineWidth);
  12.         barCodeHeight = 18;
  13.         alphaHeight = 10;
  14.  
  15.     procedure DrawBarCodeStr (theStr: Str255; var h:integer; v: integer; alpha: boolean);
  16.     procedure DrawBarCodeChar (theChar: char; var h:integer; v: integer; alpha: boolean);
  17.  
  18. implementation
  19.  
  20.     uses
  21.         Quickdraw,Resources;
  22.         
  23.     procedure DrawBarCodeStr (theStr: Str255; var h:integer; v: integer; alpha: boolean);
  24.         var
  25.             i: integer;
  26.     begin
  27.         for i := 1 to length(theStr) do begin
  28.             DrawBarCodeChar(theStr[i], h, v, alpha);
  29.         end;
  30.     end;
  31.  
  32.     procedure DrawBarCodeChar (theChar: char; var h:integer; v: integer; alpha: boolean);
  33.  
  34.         procedure White (width: integer);
  35.         begin
  36.             h := h + width;
  37.         end;
  38.  
  39.         procedure Black (width: integer);
  40.         begin
  41.             PenSize(width, 1);
  42.             MoveTo(h, v);
  43.             LineTo(h, v + barCodeHeight);
  44.             h := h + width;
  45.         end;
  46.  
  47.         type
  48.             CodeData = array[0..127] of longint;
  49.             CodeDataPtr = ^CodeData;
  50.             CodeDataHandle = ^CodeDataPtr;
  51.         var
  52.             codes: CodeDataHandle;
  53.             n: longint;
  54.             i, m: integer;
  55.     begin
  56.         codes := CodeDataHandle(GetResource('BARC', 128));
  57.         if ('a'<=theChar) & (theChar<='z') then begin
  58.             theChar := chr(ord(theChar)-$20);
  59.         end;
  60.         if (codes <> nil) & (ord(theChar) <= 127) & (codes^^[ord(theChar)] <> -1) then begin
  61.             n := codes^^[ord(theChar)];
  62.             for i := 8 downto 0 do begin
  63.                 m := BAND(BSR(n, i * 2), $03);
  64.                 case m of
  65.                     0: 
  66.                         White(narrowLineWidth);
  67.                     1: 
  68.                         White(wideLineWidth);
  69.                     2: 
  70.                         Black(narrowLineWidth);
  71.                     3: 
  72.                         Black(wideLineWidth);
  73.                 end;
  74.             end;
  75.             White(narrowLineWidth);{White space between barcodes}
  76.             if alpha then begin
  77.                 MoveTo(h - (3 * (barCodeWidth div 4)), v + barCodeHeight + 11);
  78.                 drawChar(theChar);
  79.             end;
  80.         end;
  81.     end;
  82. end.
  83.